home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / umich / tex / td187src.lzh / VECTORFO.I < prev    next >
Text File  |  1991-12-14  |  19KB  |  651 lines
  1. IMPLEMENTATION MODULE VectorFont;
  2.  
  3. FROM Diverses        IMPORT round, NumAlert, Alert, MouseOn, MouseOff;
  4. FROM FileIO          IMPORT Fopen, EOF, AgainChar, Reset, Close, ReadChar;
  5. FROM Types           IMPORT TextPosTyp, DrawObjectTyp, CodeAryTyp,
  6.                             ExtendedPtrTyp, ExtendedArraySize,
  7.                             ObjectPtrTyp;
  8. FROM SYSTEM          IMPORT BYTE, WORD, ADDRESS , ADR, TSIZE ;
  9. FROM Storage         IMPORT ALLOCATE , DEALLOCATE ;
  10. IMPORT CommonData ;
  11. IMPORT GetFile;
  12. IMPORT MathLib0 ;
  13. IMPORT MagicAES;
  14. IMPORT MagicDOS ;
  15. IMPORT MagicStrings ;
  16. IMPORT MagicSys ;
  17. IMPORT MagicVDI;
  18. IMPORT mtAlerts;
  19. IMPORT mtAppl;
  20. IMPORT Variablen ;
  21.  
  22. (**
  23. IMPORT Debug;
  24. **)
  25.  
  26. CONST MaxCache  = 1000; (* maximal 1000 Linien puffern *)
  27.       DebugMode = FALSE;
  28.       LIntMode  = FALSE;
  29.  
  30. TYPE  Matrix            = ARRAY [1..2],[1..2] OF LONGREAL;
  31. (*$? LIntMode:
  32.       IMatrix           = ARRAY [1..2],[1..2] OF LONGINT;
  33. *)
  34.       ChrString         = ARRAY [0..3] OF CHAR;
  35.       Buffer            = POINTER TO ARRAY [0..32000] OF BYTE;
  36.       (* Interne Zeichensatz-Tabelle *)
  37.       ChrEntry          = RECORD
  38.                             Header  : INTEGER;
  39.                             Name    : INTEGER;
  40.                             Address : INTEGER;
  41.                             Width   : INTEGER;
  42.                             Vec     : INTEGER;
  43.                             Bufsize : LONGCARD;
  44.                             Buf     : Buffer;
  45.                           END;
  46.  
  47. VAR FontLoaded          : INTEGER;
  48. (* Vorbereitung auf mehrere Zeichensätze zur gleichen Zeit *)
  49.     ChrTable            : ARRAY [1..MaxFonts] OF ChrEntry;
  50.     FontSize            : LONGCARD;
  51.     ActStyle            : ChrEntry;
  52.     ScaleX, ScaleY      : LONGREAL;
  53.     Slant               : LONGREAL;
  54.     Direction           : INTEGER;
  55.     Turn                : Matrix;
  56. (*$? LIntMode:
  57.     ITurn               : IMatrix;
  58.     IScaleX, IScaleY    : LONGINT;
  59.     ISlant              : LONGINT;
  60. *)
  61.     CacheIt             : BOOLEAN;
  62.     CacheFull           : BOOLEAN;
  63.     Cache               : ARRAY [0..4*MaxCache] OF INTEGER;
  64.  
  65. (* ----------------------------------------------------------------- *)
  66.  
  67. PROCEDURE EnableCache(enable : BOOLEAN);
  68. BEGIN
  69.   CacheIt  := enable;
  70.   Cache[0] := 0;
  71. END EnableCache;
  72.  
  73. PROCEDURE AgainText;
  74. VAR dum        : INTEGER;
  75.     (*$Reg*) i : INTEGER;
  76.     (*$Reg*) j : INTEGER;
  77.     (*$Reg *) count : INTEGER;
  78.     xy         : ARRAY [0..3] OF INTEGER;
  79. BEGIN
  80.   MagicVDI.SetClipping ( mtAppl.VDIHandle, CommonData.ClipXY , TRUE) ;
  81.   MouseOff;
  82.   dum := MagicVDI.SetLinecolor ( mtAppl.VDIHandle , MagicAES.BLACK ) ;
  83.   dum := MagicVDI.SetLinewidth ( mtAppl.VDIHandle , 1);
  84.   MagicVDI.SetLineEndstyles ( mtAppl.VDIHandle ,
  85.                               MagicVDI.Cornerd , MagicVDI.Cornerd ) ;
  86.   count := 1;
  87.   FOR i:=1 TO Cache[0] DO
  88.     FOR j:=0 TO 3 DO
  89.       xy[j] := Cache[count+j];
  90.     END;
  91.     MagicVDI.Polyline ( mtAppl.VDIHandle , 2 , xy ) ;
  92.     INC(count, 4);
  93.   END;
  94.   MagicVDI.SetClipping ( mtAppl.VDIHandle  , CommonData.ClipXY , FALSE) ;
  95.   MouseOn;
  96. END AgainText;
  97.  
  98. (* ----------------------------------------------------------------- *)
  99.  
  100. PROCEDURE Integ ( num : BYTE ) : INTEGER;
  101. VAR res : INTEGER;
  102. BEGIN
  103. (**
  104.   res := ORD(CHAR(num));
  105.   IF res>=80H THEN
  106.     res :=  res - 256;
  107.   END;
  108.   RETURN res;
  109. **)
  110.   RETURN INT(num); (* MM2 spezifisch *)
  111. END Integ;
  112.  
  113. (* ----------------------------------------------------------------- *)
  114.  
  115. PROCEDURE SetDirection(angle : INTEGER);
  116. VAR Rangle : LONGREAL; c : CARDINAL;
  117. BEGIN
  118.   IF angle<0 THEN
  119.     Direction := 360 - (ABS(angle) MOD 360);
  120.    ELSE
  121.     Direction := angle MOD 360;
  122.   END;
  123.   (*
  124.      Merke: die Drehmatrix bei einer Drehung um α Grad (entgegen dem
  125.      Uhrzeigersinn) lautet:
  126.      ( cos α    - cos (90-α)  )   ( cos α   -sin α )
  127.      (                        ) = (                )
  128.      ( sin α      sin (90-α)  )   ( sin α    cos α )
  129.   *)
  130. (* TDI: Rangle := MathLib0.DegToRad(MathLib0.real(Direction)); *)
  131.   Rangle := MathLib0.rad(MathLib0.real(Direction));
  132.  
  133.   Turn [1,1] := MathLib0.cos(Rangle);  
  134.   Turn [1,2] :=-MathLib0.sin(Rangle);
  135.   Turn [2,1] := MathLib0.sin(Rangle);  
  136.   Turn [2,2] := MathLib0.cos(Rangle);
  137. (*$? LIntMode:
  138.   ITurn[1,1] := MathLib0.entier(100.0 * Turn[1, 1]);
  139.   ITurn[1,2] := MathLib0.entier(100.0 * Turn[1, 2]);
  140.   ITurn[2,1] := MathLib0.entier(100.0 * Turn[2, 1]);
  141.   ITurn[2,2] := MathLib0.entier(100.0 * Turn[2, 2]);
  142. *)
  143. END SetDirection;
  144.  
  145. (* ----------------------------------------------------------------- *)
  146.  
  147. PROCEDURE TurnedVal(       X,    Y : INTEGER;
  148.                     VAR NewX, NewY : INTEGER);
  149. VAR x, y, newx, newy : LONGREAL;
  150. BEGIN
  151.   x := MathLib0.real(X) * ScaleX;
  152.   y := MathLib0.real(Y) * ScaleY;
  153.   x := x + y * Slant;
  154.   newx := x * Turn[1,1] + y * Turn[1,2];
  155.   newy := x * Turn[2,1] + y * Turn[2,2];
  156.   NewX := round(newx);
  157.   NewY := round(newy);
  158. END TurnedVal;
  159.  
  160. (** War ein Versuch der nicht klappte.... 
  161. PROCEDURE TurnedVal(       X,    Y : INTEGER;
  162.                     VAR NewX, NewY : INTEGER);
  163. VAR x, y, newx, newy, it11, it12, it21, it22 : LONGINT;
  164. BEGIN
  165.   x := MagicSys.CastToLInt(X);
  166.   x := MagicSys.CastToLInt(Y);
  167. (**
  168.   x := x + (y * ISlant) DIV 10;
  169. **)
  170.   it11 := ITurn[1,1];  it12 := ITurn[1,2];
  171.   it21 := ITurn[2,1];  it22 := ITurn[2,2];
  172. (**
  173.   newx := x * ITurn[1,1] + y * ITurn[1,2];
  174.   newy := x * ITurn[2,1] + y * ITurn[2,2];
  175. **)
  176.   newx := (x * it11) + (y * it12);
  177.   newy := (x * it21) + (y * it22);
  178.   newx := newx * IScaleX;
  179.   newy := newy * IScaleY;
  180.   NewX := MagicSys.CastToInt(newx DIV 10000);
  181.   NewY := MagicSys.CastToInt(newy DIV 10000);
  182. END TurnedVal;
  183. **)
  184.  
  185. (* ----------------------------------------------------------------- *)
  186.  
  187. PROCEDURE LoadFont ( REF input : ARRAY OF CHAR;
  188.                      VAR handle : INTEGER ) : BOOLEAN;
  189. (*
  190.    Fragt nach Namen der zu benutzenden Font-Datei
  191.    (von Turbo-Pascal/Turbo-C geklaut; die wiederum von Hershey)
  192. *)
  193. VAR ch           : CHAR;
  194.     i            : INTEGER;
  195.     filehandle   : INTEGER;
  196.     length       : LONGCARD;
  197.     Start        : INTEGER;
  198.     dummy        : INTEGER;
  199.  
  200.     PROCEDURE FontOK(fontname : ARRAY OF CHAR) : BOOLEAN;
  201.     (* Überprüft, ob regulärer Font *)
  202.     VAR fhandle : INTEGER;
  203.         c       : CHAR;
  204.         res     : BOOLEAN;
  205.  
  206.         PROCEDURE CheckChar(char : CHAR);
  207.         BEGIN
  208.           ReadChar(fhandle, c);
  209.           res := res AND (c=char);
  210.         END CheckChar;
  211.  
  212.     BEGIN
  213.       Reset(fhandle, fontname);
  214.       res := TRUE;
  215.       CheckChar('P');     (* P hilipp *)  (* <- Der Chef von *)
  216.       CheckChar('K');     (* K ahn    *)  (* <- Borland !!   *)
  217.       Close(fhandle);
  218.       RETURN res;
  219.     END FontOK;
  220.  
  221. BEGIN
  222.   handle := -1;
  223.   IF FontLoaded<MaxFonts THEN
  224. (**
  225.     RTD.Message(input);
  226.     RTD.ShowVar('FontLoaded', FontLoaded);
  227. **)
  228.     IF FontOK(input) THEN
  229.       length := GetFile.FileSize(input);
  230.       ChrTable[FontLoaded+1].Bufsize := length;
  231. (**
  232.       RTD.ShowVar('Size', ChrTable[FontLoaded+1].Bufsize);
  233. **)
  234.       IF length>0 THEN
  235.         IF Fopen ( filehandle , MagicDOS.Read, input ) THEN
  236.           ALLOCATE(ChrTable[FontLoaded+1].Buf, length);
  237.           IF ChrTable[FontLoaded+1].Buf <> NIL THEN
  238.             WITH ChrTable[FontLoaded+1] DO
  239.               MagicDOS.Fread(filehandle, length, Buf);
  240.               Close(filehandle);
  241.               Start := 3;
  242.               (* Anfangs-Message überspringen *)
  243.               WHILE (CHAR(Buf^[Start])<>CHAR(1AH)) DO
  244.                 INC(Start);
  245.               END;
  246.  
  247.               Name   := Start + 3;
  248.               Header := ORD(CHAR(Buf^[Start+1])) +
  249.                 0100H * ORD(CHAR(Buf^[Start+2]));
  250.               Vec :=          ORD(CHAR(Buf^[Header+5])) +
  251.                      0100H  * ORD(CHAR(Buf^[Header+6]));
  252.               Vec := Vec + Header;
  253.               Address := Header + 010H;
  254.               Width   := 2 * ORD(CHAR(Buf^[Header+1]));
  255.               Width   := Width + Address;
  256.               ch      := CHAR(Buf^[Header]);
  257. (**
  258.               RTD.ShowVar('Name', Name);
  259.               R